home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / faq-s.zip / STATRET.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-30  |  3KB  |  124 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit statret;
  5.  
  6. interface
  7.  
  8. uses gentypes,dos,configrt;
  9.  
  10. type systemstatus=array [1..511] of byte;
  11.  
  12. var numcallers:real;
  13.     tonext:integer;
  14.     sysopavail:availtype;
  15.     lastdayup:sstr;
  16.     numdaysup,callstoday:integer;
  17.     numminsidle,numminsused,numminsxfer:minuterec;
  18.     messages,ups,emails,gfilez,dbases:integer;
  19.     timedeventdate:sstr;
  20.     newfeedback,newuploads,newcalls,newposts,newmail,newusers{,screendef}:integer;
  21.     netmade:boolean;
  22.     dummyfiller:array [1..499] of byte;
  23.  
  24. function timer:integer;
  25. procedure starttimer (var m:minuterec);
  26. function elapsedtime (var m:minuterec):integer;
  27. procedure stoptimer (var m:minuterec);
  28. procedure stoptimer2 (var m:minuterec);
  29. procedure writestatus;
  30. procedure readstatus;
  31.  
  32. implementation
  33.  
  34. function timer:integer;
  35. var r:registers;
  36. begin
  37.   r.ax:=$2c00;
  38.   intr ($21,r);
  39.   timer:=(r.cx shr 8)*60+(r.cx and 255)
  40. end;
  41.  
  42. procedure starttimer (var m:minuterec);
  43. begin
  44.   if m.started then exit;
  45.   m.startedat:=timer;
  46.   m.started:=true
  47. end;
  48.  
  49. function elapsedtime (var m:minuterec):integer;
  50. var n:integer;
  51. begin
  52.   if not m.started then begin
  53.     elapsedtime:=0;
  54.     m.startedat:=timer;
  55.     exit
  56.   end;
  57.   n:=timer-m.startedat;
  58.   if n<0 then n:=n+1440;
  59.   elapsedtime:=n
  60. end;
  61.  
  62. procedure stoptimer (var m:minuterec);
  63. begin
  64.   if not m.started then begin
  65.     m.startedat:=0;
  66.     exit
  67.   end;
  68.   m.startedat:=elapsedtime(m);
  69.   m.total:=m.total+m.startedat;
  70.   m.started:=false
  71. end;
  72.  
  73. procedure stoptimer2 (var m:minuterec);
  74. begin
  75.   if not m.started then begin
  76.     m.startedat:=0;
  77.     exit
  78.   end;
  79.   m.startedat:=elapsedtime(m);
  80.   m.total:=0;
  81.   m.started:=false
  82. end;
  83.  
  84. procedure writestatus;
  85. const numtimers=3;
  86. type timerset=array [1..numtimers] of minuterec;
  87. var realt:timerset absolute numminsidle;
  88.     t:timerset;
  89.     cnt:integer;
  90.     ss:systemstatus absolute numcallers;
  91.     f:file of systemstatus;
  92. begin
  93.   assign (f,bbsdatadir+'Status.dat');
  94.   rewrite (f);
  95.   t:=realt;
  96.   for cnt:=1 to numtimers do
  97.     if realt[cnt].started
  98.      then stoptimer (realt[cnt]);
  99.   write (f,ss);
  100.   realt:=t;
  101.   close (f)
  102. end;
  103.  
  104. procedure readstatus;
  105. var f:file of systemstatus;
  106.     ss:systemstatus absolute numcallers;
  107. begin
  108.   assign (f,bbsdatadir+'Status.dat');
  109.   reset (f);
  110.   if ioresult<>0 then begin
  111.     fillchar (numcallers,511,0);
  112.     tonext:=-1;
  113.     sysopavail:=bytime;
  114.     writestatus;
  115.     exit
  116.   end;
  117.   read (f,ss);
  118.   close (f)
  119. end;
  120.  
  121. begin
  122. end.
  123.  
  124.